perm filename FILLXG.FAI[XX,LCS]3 blob
sn#219703 filedate 1976-06-15 generic text, type T, neo UTF8
00100 TITLE FILL
00200 ENTRY FILLER,LINES,PLOTS,NOIR
00300 EXTERNAL DST,PLTR,DPY,.COMM.,ROFF,XRN,SQRT,PLOT
00500 ;; DEFINE FLOAT(N)
00600 ;; < TLC N,232000
00700 ;; FADR N,N >
00800 DEFINE FIXX(N)
00900 < KIFIX N,N ↔ >
01500
01600 KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01700 RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01800 HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01900
02000 ; SUBROUTINE FILLER(Q,M)
02100 FILLER: 0
02200 MOVEM 16,SV16#
02300 HRRZ J,(16)
02400 HRRZM J,SVQ#
02500 HRRZ T,@1(16)
02600 HRRZM T,SVM# ; KK=NE(1)
02700 HRRZ KK,2(J)
02800 ADDI KK,-1(J)
02900 ; DO 4 K=2,KK
03000 HRRZI L,2(J)
03100 ; IF(NE(K).NE.3)GO TO 11
03200 L4: ADDI L,3
03300 HRRZ T,(L)
03400 L11: SETZM (L)
03500 CAIN T,3
03600 ; NE(K)=-1
03700 SETOM (L)
03800 ; GO TO 4
03900 ; 11 NE(K)=0
04000 ; 4 CONTINUE
04100 CAIGE L,(KK)
04200 JRST L4
04300 ; RLFT=10000
04400 MOVE RL,[=10000.0]
04500 ; RT=-10000
04600 MOVN RJ,[=10000.0]
04700 ; B=RT
04800 MOVE B,RJ
04900 ; DO 12 K=1,KK
05000 HRRZI L,-3(J)
05100 ; H=IFIX(Q(K))
05200 L12: ADDI L,3
05300 MOVE H,(L)
05400 FIXX(H)
05500 FLTR H,H ;KL10 FLOAT
05600 ; IF(H.LT.RLFT)RLFT=H
05700 CAMGE H,RL
05800 MOVE RL,H
05900
06000 ; IF(H.GT.RT)RT=H
06100 CAMLE H,RJ
06200 MOVE RJ,H
06300 ; IF(H.EQ.B)NE(K)=-1
06400 CAMN H,B
06500 SETOM 2(L)
06600 ; B=H
06700 MOVE B,H
06800 ; Q(K)=H
06900 MOVEM H,(L)
07000 ; 12 R(K)=IFIX(R(K))
07100 MOVE T,1(L)
07200 FIXX(T)
07300 FLTR T,T ;FLOAT
07400 MOVEM T,1(L)
07500 CAIGE L,-2(KK)
07600 JRST L12
07700 ; NE(KK+1)=-1
07800 SETOM 3(KK)
07900
08000 ; LRT=RT
08100 FIXX(RJ)
08200 MOVEM RJ,LRT#
08300 ; JA=3
08400 HRRZI T,3
08500 HRRZM T,JA#
08600
08700
08800 ; 124 LEFT=RLFT
08900 L124: MOVE LE,RL
09000 FIXX(LE)
09100 ; 51 J=LEFT
09200 L51: MOVE J,LE
09300 ; 42 RJ=J+.001
09400 ;;L42: MOVE RJ,J
09500 L42: FLTR RJ,J ;FLOAT J, PUT IT IN RJ
09600 FADR RJ,[=0.001]
09700 ; JCONT=0
09800 SETZM JCONT#
09900 ; LEFT=J
10000 MOVE LE,J
10100
10200 ; JJ=-1
10300 SETO JJ,
10400 ; ALT=-10000.
10500 MOVN AL,[=10000.0]
10600 ; 200 DO 45 L=2,KK
10700 HRRZ L,SVQ
10800 L45: ADDI L,3
10900 CAILE L,-2(KK)
11000 JRST L455
11100 ; IF(NE(L).NE.0)GO TO 45
11200 SKIPE 2(L)
11300 JRST L45
11400 ; IF(MISS(L,RJ,Q))GO TO 45
11500 CAML RJ,-3(L)
11600 JRST L201
11700 CAMLE RJ,(L)
11800 JRST L202
11900 L201: CAMGE RJ,(L)
12000 CAMG RJ,-3(L)
12100 JRST L45
12200 ; H=HGHT(L,RJ,Q,R)
12300 L202: MOVE H,-2(L)
12400 CAMN H,1(L)
12500 JRST RET
12600 MOVNS H
12700 FADR H,1(L)
12800 MOVE D,-3(L)
12900 MOVNS T,D
13000 FADR T,RJ
13100 FADR D,(L)
13200 FMPR H,T
13300 FDVR H,D
13400 FADR H,-2(L)
13500 ; IF(H.LT.ALT)GO TO 45
13600 RET: CAMGE H,AL
13700 JRST L45
13800
13900 ; ALT=H
14000 MOVE AL,H
14100 ; JJ=L
14200 HRRZI JJ,(L)
14300 ; 45 CONTINUE
14400 JRST L45
14500 ; IF(JJ)GO TO 43
14600 L455: JUMPL JJ,L43
14700 ; JCONT=-1
14800 SETOM JCONT
14900 ; LEFT=J
15000 MOVE LE,J
15100 ; 46 JA=3
15200 L46: HRRZI T,3
15300 HRRZM T,JA
15400 ; JORD=-1
15500 SETOM JORD#
15600 ; 52 KN=Q(JJ)
15700 L52: MOVE T,(JJ)
15800 FIXX(T)
15900 MOVEM T,KN#
16000 ; KL=Q(JJ-1)
16100 MOVE T,-3(JJ)
16200 FIXX(T)
16300
16400 MOVEM T,KL#
16500 ; IF(KN.LT.KL)KN=KL
16600 CAMLE T,KN
16700 MOVEM T,KN
16800 ; 50 I=J
16900 L50: MOVEM J,I#
17000 ; 102 RJ=I+.01
17100 ;;L102: MOVE RJ,I
17200 L102: FLTR RJ,I ;FLOAT I, PUT IT IN RJ
17300 FADR RJ,[=0.1] ;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
17400 ; ALT=HGHT(JJ,RJ,Q,R)
17500 MOVE AL,-2(JJ)
17600 CAMN AL,1(JJ)
17700 JRST RET2
17800 MOVNS AL
17900 FADR AL,1(JJ)
18000 MOVE D,-3(JJ)
18100 MOVNS T,D
18200 FADR T,RJ
18300 FADR D,(JJ)
18400 FMPR AL,T
18500 FDVR AL,D
18600 FADR AL,-2(JJ)
18700 ; B=-10000
18800 RET2: MOVN B,[=10000.0]
18900 ; JK=-1
19000 SETO JK,
19100 ; XALT=ALT+.001
19200 MOVE T,AL
19300 FADR T,[=0.001]
19400 MOVEM T,XALT#
19500
19600 ; ZALT=ALT
19700 MOVEM AL,ZALT#
19800 ; 400 DO 47 L=2,KK
19900 MOVE L,SVQ
20000 L47: ADDI L,3
20100 CAILE L,-2(KK)
20200 JRST L477
20300 ; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20400 CAME L,JJ
20500 SKIPGE 2(L)
20600 JRST L47
20700 CAML RJ,-3(L)
20800 JRST L475
20900 CAMLE RJ,(L)
21000 JRST L476
21100 L475: CAMGE RJ,(L)
21200 CAMG RJ,-3(L)
21300 JRST L47
21400 ; H=HGHT(L,RJ,Q,R)
21500 L476: MOVE H,-2(L)
21600 CAMN H,1(L)
21700 JRST RET3
21800 MOVNS H
21900 FADR H,1(L)
22000 MOVE D,-3(L)
22100 MOVNS T,D
22200 FADR T,RJ
22300 FADR D,(L)
22400 FMPR H,T
22500 FDVR H,D
22600 FADR H,-2(L)
22700 ; IF(H.GT.XALT)GO TO 47
22800 RET3: CAMG H,XALT
22900
23000 ; IF(H.LE.B)GO TO 47
23100 CAMG H,B
23200 JRST L47
23300 ; B=H
23400 MOVE B,H
23500 ; JK=L
23600 HRRZI JK,(L)
23700 ; 47 CONTINUE
23800 JRST L47
23900 ; IF(JK)GO TO 48
24000 L477: JUMPL JK,L48
24100 ; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24200 MOVN T,B
24300 FADR T,ZALT
24400 CAMG T,[=0.001]
24500 CAME J,I
24600 JRST L59
24700 ; JX=Q(JK)
24800 MOVE T,(JK)
24900 FIXX(T)
25000 ; IF(JX.GT.KN)GO TO 60
25100 CAMLE T,KN
25200 JRST L60
25300 ; JX=Q(JK-1)
25400 MOVE T,-3(JK)
25500 FIXX(T)
25600 ; IF(JX.LT.KN)GO TO 59
25700 CAMGE T,KN
25800 JRST L59
25900 ; 60 L=JJ
26000 L60: MOVE L,JJ
26100 ; JJ=JK
26200 MOVE JJ,JK
26300 ; JK=L
26400 MOVE JK,L
26500 ; KN=JX
26600 MOVEM T,KN
26700
26800 ; 59 IF(ALT-B.LT.2)GO TO 62
26900 L59: MOVN T,B
27000 FADR T,AL
27100 CAMGE T,[=2.0]
27200 JRST L62
27300 ; ALT=ALT-1
27400 HRLZI T,576400
27500 FADR AL,T
27600 ; B=B+1
27700 HRLZI T,201400
27800 FADR B,T
27900 ; 62 IF(JORD)GO TO 103
28000 L62: SKIPGE JORD
28100 JRST L103
28200 ; H=B
28300 MOVE H,B
28400 ; B=ALT
28500 MOVE B,AL
28600 ; ALT=H
28700 MOVE AL,H
28800 ; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28900
29000 CAMN JK,NK#
29100 JRST L103
29200 MOVN T,B
29300 FADR T,AL
29400 SKIPGE T
29500 MOVNS T
29600 CAMG T,[5.0]
29700 JRST L103
29800 HRRZI T,3
29900 HRRZM T,JA
30000 ; 103 CALL LINES(RJ,ALT,JA)
30100 L103: MOVEM RJ,SVRJ#
30200 MOVEM AL,SVAL#
30300 MOVEM B,SVB#
30400 HRRZI 16,SVAC
30500 BLT 16,SVAC+15
30600 JSA 16,LINES
30700 JUMP SVRJ
30800 JUMP SVAL
30900 JUMP JA
31000 ; 100 CALL LINES(RJ,B,2)
31100 JSA 16,LINES
31200 JUMP SVRJ
31300 JUMP SVB
31400 JUMP [2]
31500 HRLZI 16,SVAC
31600 BLT 16,15
31700 ; NK=JK
31800 MOVEM JK,NK
31900
32000 ; JORD=-JORD
32100 MOVNS JORD
32200 ; NE(JK)=1
32300 HRRZI T,1
32400 HRRZM T,2(JK)
32500 ; NE(JJ)=-1
32600 SETOM 2(JJ)
32700 ; JA=2
32800 HRRZI T,2
32900 HRRZM T,JA
33000 ; I=I+M
33100 MOVE T,SVM
33200 ADDB T,I
33300 ; IF(I.LT.KN)GO TO 102
33400 CAMGE T,KN
33500 JRST L102
33600 ; L=1
33700 HRRZI L,3
33800 ; IF(KN.EQ.KL)L=-1
33900 MOVE T,KN
34000 CAMN T,KL
34100 HRROI L,-3
34200 ; JJ=JJ+L
34300 ADD JJ,L
34400 ; J=0
34500 SETZ J,
34600 ; IF(L)J=-1
34700 SKIPGE L
34800 HRROI J,-3
34900 ; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
35000 SKIPN 2(JJ)
35100 CAILE JJ,-2(KK)
35200 JRST L124
35300 ADD T,SVM
35400 FLTR T,T
35500 HRRZI HG,(JJ)
35600 ADD HG,J
35700 CAMLE T,(HG)
35800 JRST L124
35900 ; J=I
36000 MOVE J,I
36100 ; GO TO 52
36200 JRST L52
36300 ; 48 JA=3
36400 L48: HRRZI T,3
36500 HRRZM T,JA
36600 ; 43 J=LEFT+M
36700 L43: MOVE J,LE
36800 ADD J,SVM
36900 ; IF(J.LE.LRT)GO TO 42
37000 CAMG J,LRT
37100 JRST L42
37200 ; IF(JCONT)GO TO 51
37300 SKIPGE JCONT
37400 JRST L51 ; END
37500 MOVE 16,SV16
37600 JRA 16,2(16)
37700 SVAC: BLOCK 16
37800
37900 ; SUBROUTINE LINES(A,B,L)
38000 ; COMMON/DST/BB,CC
38100 ; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38200 ; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38300 ; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38400 ; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38500 ; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38600 ; 1,(JJ2,JJ(2))
38700 ; DATA BB/.008/,CC/3.5/
38800 ;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38900
39000 M←2 ↔ NZ←3 ↔ K←4
39100
39200 LINES: 0
39300 ; GO TO 23
39400 JRST L23
39500 ;22 IF(JQ(1).NE.0)GO TO 23
39600 L22: SKIPE PLTR+=27
39700 JRST L23
39800 ; IF(CC.EQ.1000)GO TO 23
39900 MOVSI T,212764
40000 CAMN T,DST+1
40100 JRST L23
40200 ; B=B*(CC-BB*ABS(A))
40300 MOVE T,@(16)
40400 MOVMS T
40500 FMPR T,DST
40600 FSBR T,DST+1
40700 FMPRM T,@1(16)
40800 MOVNS @1(16)
40900 ;23 IF(IPLT)GO TO 2
41000 L23: SKIPGE PLTR
41100 ;; JRST L2
41200 JRST L9
41300 MOVE T,.COMM.+1 ;IF(JA.EQ.44)RETURN
41400 CAIN T,=44 ;WON'T LOOK AT BARLINES FOR HEIGHT.
41500 JRA 16,3(16)
41600 MOVE T,@1(16)
41700 CAMG T,DPY+1
41800 JRST L333
41900 MOVEM T,DPY+1 ; IF(B.LT.BOT)BOT=B
42000 JRA 16,3(16)
42100 L333: CAMG T,DPY+2
42200 MOVEM T,DPY+2
42300 JRA 16,3(16) ; IF(B.GT.TOP)TOP=B
42400 ;2 IF(IPLT.EQ.-2)RETURN
42500 ;;L2: MOVNI T,2
42600 ;; CAMN T,PLTR
42700 ;; JRA 16,3(16)
42800 ;9 M=ROFF(A*DIS)
42900 L9: MOVE M,@(16)
43000 FMPR M,PLTR+2
43100 SKIPGE M
43200 FADR M,[-=1.0]
43300 FADR M,[=0.5]
43400 FIXX(M)
43500 MOVEM M,MM#
43600 ; N=ROFF(B*RHT)
43700 MOVE NZ,@1(16)
43800 FMPR NZ,PLTR+1
43900 SKIPGE NZ
44000 FADR NZ,[-=1.0]
44100 FADR NZ,[=0.5]
44200 FIXX(NZ)
44300 MOVEM NZ,NN#
44400 ;8 CALL PLOT(M,N,L)
44500 L8: MOVE T,@2(16)
44600 MOVEM T,LL#
44700 JSA 16,PLOT
44800 JUMP MM
44900 JUMP NN
45000 JUMP LL
45100 ; END
45200 JRA 16,3(16)
45300
51600 PLOTS: 0
51700 JRA 16,1(16) ; DUMMY ROUTINE
51800
51900 J←10↔ A←2↔ B←3↔ C←4↔ D←5↔ E←6↔ NQ←11↔NX←12 ; SUBROUTINE NOIR(RMINI)
52000 Y←13↔ X←14↔ L←15↔ M←1
52100 JPOS: 0 ;C BLACKS IN NOTES
52200 IPOS: 0 ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
52300 IC: 0
52400 KZ: 0
52500 NOIR: 0 ; COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
52600 MOVE A,.COMM.+4 ;EQUIVALENCE (PRE,IRN(1))
52700 FMPR A,PLTR+2 ;DATA BL/7.5/,BH/6.7/
52800 ; ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
52900 JSA 16,ROFF ;IPOS=ROFF(RJQ(1)*DIS)
53000 JUMP A
53100 FIXX(A)
53200 MOVEM A,IPOS
53300 MOVE A,.COMM.+2 ;JPOS=ROFF(CENTR*RHT)
53400 FMPR A,PLTR+1
53500 JSA 16,ROFF
53600 JUMP A
53700 FIXX(A)
53800 ;?? MOVE D,@(16)
53900 ;?? CAME D,STF+8 ;IF(RMINI.NE.RSTJ2)JPOS=JPOS+1
54000 ;?? AOS A ;TO PUSH MINI-NOTE UP ONE XGP NOTCH!!!! *******************
54100 MOVEM A,JPOS ;SAVE FOR LATER
54200 MOVN A,@(16) ;IF(-RMINI.EQ.PRE)GO TO 10
54300 CAMN A,XRN
54400 JRST NO10
54500 MOVEM A,XRN ;PRE=-RMINI
54600 MOVE D,[=0.25] ;D=.25
54700 MOVE B,[=6.7] ;B=BH*RMINI*RHT
54800 FMPR B,PLTR+1
54900 FMPR B,@(16)
55000 MOVE E,PLTR+2 ;E=RMINI*DIS
55100 FMPR E,@(16)
55200 MOVE A,[=7.5] ;A=BL*E
55300 FMPR A,E
55400 MOVE 15,A
55500 FIXX(15) ;IC=A
55600 MOVEM 15,IC
55700 FMPR A,A ;A=A*A
55800 MOVN E,B ;E=-B/4.
55900 FDVR E,[=4.0]
56000 MOVE 15,B ;K=B
56100 FIXX(15)
56200 MOVEM 15,KZ
56300 FMPR B,B ;B=B*B
56400 ; USES EQUATION FOR ELLIPSE
56500 MOVEI 11,1 ;N=1
56600 MOVEI NX,2 ;NX=2
56700 MOVN J,KZ ;6 DO 1 J=-K,K
56800 NO1: MOVE Y,J ;Y=J*J
56900 IMUL Y,Y
57000 FLTR Y,Y ;FLOAT
57100 MOVNS Y ;X=SQRT(A-(A*Y)/B)
57200 FMPR Y,A
57300 FDVR Y,B
57400 FADR Y,A
57500 JSA 16,SQRT
57600 JUMP Y
57800 MOVE L,E ;L=E-X
57900 FSBR L,0
58000 FIXX(L)
58100 ;; MOVE M,X ;M=X+E
58200 ;; FADR M,E
58250 FADR 0,E
58300 FIXX(0) ; THE TWO SIDES OF THE LINE
58400 SKIPGE 11 ;IF(N)CALL EXCH(L,M)
58500 EXCH L,0
58600 MOVEM L,XRN-1(NX)
58700 MOVEM 0,XRN(NX) ; C IS VERTICLE POS.
58800 ADDI NX,2 ;NX=NX+2
58900 FADR E,D ;E=E+D E IS TO TILT IT.
59000 MOVNS 11 ;1 N=-N
59100 CAMGE J,KZ
59200 AOJA J,NO1 ;LOOP BACK
59300 NO10: MOVE J,IPOS ;10 CALL PLOT(IPOS+3,JPOS,3)
59400 ADDI J,3
59500 JSA 16,PLOT
59600 JUMP J
59700 JUMP JPOS
59800 JUMP [3]
59900 MOVEI 11,2 ;N=2 1ST LOC. OF ARRAY HAS "PRE"
60000 MOVE L,IC ;L=IPOS+IC
60100 ADD L,IPOS
60200 MOVN M,KZ ;DO 11 M=-K,K
60300 NO11: MOVE J,JPOS ;J=M+JPOS
60400 MOVEM M,PLOTS
60500 ADD J,M ;CALL PLOT(L+IRN(N),J,2)
60600 MOVE NX,XRN-1(11)
60700 ADD NX,L
60800 JSA 16,PLOT
60900 JUMP NX
61000 JUMP J
61100 JUMP [2] ;CALL PLOT(L+IRN(N+1),J,2)
61200 MOVE NX,XRN(11)
61300 ADD NX,L
61400 JSA 16,PLOT
61500 JUMP NX
61600 JUMP J
61700 JUMP [2]
61800 ADDI 11,2 ;11 N=N+2
61900 MOVE M,PLOTS
62000 CAMGE M,KZ
62100 AOJA M,NO11
62200 JRA 16,1(16)
62300
62400 END